# -*- perl -*-
# $Id: Gigabase.pm,v 1.1 2008/04/04 11:02:30 knizhnik Exp $
# DBD::Gigabase
# DBI compatibility emulation for GigaBASE ORDBMS 
# Created by Pavel Zheltouhov <pavlo@tvrn.ru> 
# for Ratmir ADS www.ratmir.ru
# 
{

package DBD::Gigabase;
use DBI qw(:sql_types);
use Gigabase qw/:clicodes/; # interface based on GigaBase CLI api


@EXPORT = qw(); # Do NOT @EXPORT anything.

$VERSION = '0.01';

$err = 0;		# holds error code   for DBI::err
$errstr = "";		# holds error string for DBI::errstr
$sqlstate = "";         # holds error state  for DBI::state
$drh = undef;		# holds driver handle once initialised

%dbi_trans=(
    &cli_oid=>SQL_INTEGER,
    &cli_bool=>SQL_INTEGER,
    &cli_int1=>SQL_SMALLINT,
    &cli_int2=>SQL_SMALLINT,
    &cli_int4=>SQL_INTEGER,
    &cli_int8=>SQL_INTEGER,
    &cli_real4=>SQL_REAL,
    &cli_real8=>SQL_DOUBLE,
    &cli_decimal=>SQL_DECIMAL,
    &cli_asciiz=>SQL_VARCHAR,
    &cli_pasciiz=>SQL_VARCHAR,
    &cli_cstring=>SQL_VARCHAR
  );
use strict; 

sub param_process { # return ($count,$rewrited_sql)
   my $stat=shift;
   # process parameters
   my (@v)=($stat=~m/(\?)/g);
   my $num = @v;
   { my $i=0;
     $stat=~s/\?/'%p' . $i++/ge;
   }
   return ($num,$stat);
}

sub dequote {
 my $eval=shift;
 if ($eval=~/^\"(.*)\"$/) {
    $eval=$1; 
    $eval=~s/\\\"/\"/g;
   }elsif ($eval=~/^\'(.*)\'$/) {
     $eval=$1; 
     $eval=~s/''/'/g;
   }
 return $eval;
}
sub get_quoted($$){
 my ($str,$pos)=@_;
 return undef unless substr($str,$pos,1) eq '\'';
 my $i=$pos+1;
 my $len=length $str;
 my $v='';
 while ($i < $len) {
  my $b=substr($str,$i,1);
  if ($b eq '\'') {
   if ( substr($str,$i+1,1) eq '\'') { # double quote ?
    $i++;
   } else { # end of literal
    $i++;# skip last '\''
    last;
   }
  }
  $v .= $b;
  $i++;
 }
 return ($v,$i);
}

sub get_unquoted($$){
 my ($str,$pos)=@_;
 return undef unless substr($str,$pos,1) ne '\'';
 my $i=$pos;
 my $len=length $str;
 my $v='';
 while ($i < $len) {
  my $b=substr($str,$i,1);
  if (($b eq ',') or ($b =~/\s/)) {
    last;
  }
  $v .= $b;
  $i++;
 }
 return ($v,$i);
}

sub parse_values{
 my ($str,$i)=@_;
 my @v;
 my $len=length $str;
 while ($i < $len) {
 # skip spaces
  $i += length ( (substr($str,$i) =~/^(\s+)/s)? $1 : '');
  my $v;
  my $b=substr($str,$i,1);
  if ($b eq '\'') {
   ($v,$i)=get_quoted($str,$i);
  }else {
   ($v,$i)=get_unquoted($str,$i);
  }
  die "parse error" unless defined $v;
  $i += length ( (substr($str,$i) =~/^(\s+)/s)? $1 : '');
   $b=substr($str,$i,1);
   if ($b ne '') {
     if($b ne ',') {
       die "parse error ";
     }
   }# else end
  push @v,$v;
  $i++;
 }
return (@v);
}

sub parse_sqlset{
 my ($str,$i)=@_;
 my @vals;
 my $b;
 my $len=length $str;
 while ($i < $len) {
 # skip spaces
  $i += length ( (substr($str,$i) =~/^(\s+)/s)? $1 : '');
  my ($f,$v);
  $i += length ( (substr($str,$i) =~/^(\w+)/)? $1 : '');
  if (defined $1) {
   $f=$1;
  }else {
   last;
  }
  if ($f=~/^where$/i) {
   if (substr($str,$i)=~/^\s+[^=]/s) {
    last;
   }
  }
  $i += length ( (substr($str,$i) =~/^(\s+)/s)? $1 : '');
  $b=substr($str,$i,1);
  if($b ne '=') { die "parse error"; }
  $i++;
  $i += length ( (substr($str,$i) =~/^(\s+)/s)? $1 : '');
  $b=substr($str,$i,1);
  if ($b eq '\'') {
   ($v,$i)=get_quoted($str,$i);
  }else {
   ($v,$i)=get_unquoted($str,$i);
  }
  die "parse error" unless defined $v;
  #$vals{$f}=$v;
  push @vals,[$f,$v];
  $i += length ( (substr($str,$i) =~/^(\s+)/s)? $1 : '');
  #if ($v eq '?') {
  #       push @new_params,$ename;
  #   }
  $b=substr($str,$i,1);
  if ($b eq ',') {$i++;} #else maybe end
 }
 return ($i,@vals);
}
 
sub driver ($;$) {
    my($class, $attr) = @_;
    my $drh = eval '$' . $class . "::drh";
    if (!$drh) {
	if (!$attr) { $attr = {} };
	if (!exists($attr->{Attribution})) {
	    $attr->{Attribution} = "$class by Pavel Zheltouhov";
	}
	if (!exists($attr->{Version})) {
	    $attr->{Version} = eval '$' . $class . '::VERSION';
        }
        if (!exists($attr->{Err})) {
	    $attr->{Err} = eval '\$' . $class . '::err';
        }
        if (!exists($attr->{Errstr})) {
	    $attr->{Errstr} = eval '\$' . $class . '::errstr';
        }
        if (!exists($attr->{State})) {
	    $attr->{State} = eval '\$' . $class . '::state';
        }
        if (!exists($attr->{Name})) {
	    my $c = $class;
	    $c =~ s/^DBD\:\://;
	    $attr->{Name} = $c;
        }
    # driver private parser
        $drh = DBI::_new_drh($class . "::dr", $attr);
    }
    $drh;
}# main package

}

{
package DBD::Gigabase::dr; # ====== DRIVER ======
$imp_data_size = 0;
use strict;

sub connect ($$;$$$) {
    my($drh, $dbname, $user, $auth, $attr)= @_;

    # create a 'blank' dbh
    my $this = DBI::_new_dbh($drh, {
	'Name' => $dbname,
	'USER' => $user, 
	'CURRENT_USER' => $user,
    });

    if ($this) {
	my($var, $val);
        foreach $var (split(/;/s, $dbname)) {
          if ($var =~ /(.*?)=(.*)/s) {
            $this->STORE("gbase_$1", $2);
           }
        }
      my $host=$this->FETCH('gbase_host') || 'localhost';
      my $port=$this->FETCH('gbase_port') || 6100;
      my $con=new Gigabase::Connection($host,$port,$user,$auth);
      return  $this->DBI::set_err(1,$Gigabase::errmsg) unless $con;
      $this->STORE('gbase_con',$con);
      $this->STORE(Active => 1 );
    }
    $this;
}

sub default_user{
 return ('guest','guest');
}

sub data_sources ($;$) {
# there are no way to get all Gigabase servers ;)
 undef;
}

sub disconnect_all {
   my $dbh=shift;
   1;
}

sub DESTROY {
   undef;
}

}#package driver

{
package DBD::Gigabase::db; # ====== DATABASE ======
$imp_data_size = 0;
use strict;

sub prepare ($$;@) {
    my($dbh, $statement, @attribs)= @_;
    # create a 'blank' dbh
    my $sth = DBI::_new_sth($dbh, {'Statement' => $statement});
    if ($sth) {
        my $con=$dbh->FETCH('gbase_con');
        my $stat_class;
        my ($columnspec,$tablename,$whereclause);
        $sth->STORE('PRECISION' => undef);
        $sth->STORE('SCALE' => undef);
        $sth->STORE('NUM_OF_FIELDS' => 0);
        if ($statement=~/^\s*select/si) {
         # this is select: convert to native
         my $parsed_ok=($columnspec,$tablename,$whereclause)=
            ($statement=~/^\s*select\s*(.*?)\s+from\s+(\w+)(.*)$/si);
         if (!$parsed_ok) { 
            return $sth->DBI::set_err(1,"syntax error in query");
         } 
         my @query_columns;
         my ($names_ref,$types_ref);
         (($names_ref,$types_ref)=$con->describe_table_2arrays($tablename));
         return $dbh->DBI::set_err(1,"no such table $tablename") unless $names_ref;
	 if ($columnspec eq '*' or $columnspec eq ''){
	  @query_columns=@$names_ref;
	 }else {
          @query_columns=split /,/s,$columnspec;
          foreach my $n (@query_columns) {
           if (! grep {$n eq $_} @$names_ref ) {
             return $dbh->DBI::set_err(1,"specified column $n does not exists");
	   }
          }
	 }
         $statement="select from $tablename $whereclause";
         my $num_of_params;
	 ($num_of_params,$statement)=DBD::Gigabase::param_process($statement);
	 my $gbstat=new Gigabase::Statement($con,$statement) 
             || return $dbh->DBI::set_err($con->errcode,$con->errstr);
	 # we need only @query_columns
         # bind # keys 
         my @names=@query_columns;
         my @types= map {$DBD::Gigabase::dbi_trans{$_} } @$types_ref;
         my %hash_bind= map { $_,'';} (@names);
         foreach my $n (@names) {
          $gbstat->bind_column($n,\$hash_bind{$n});
         } 
         $sth->STORE('dbi_params'=>[]);
         $sth->STORE('gbase_class'=>'select'); # only selects implemented
         $sth->STORE('hash_of_bind'=>\%hash_bind);  # ? what is it ?
         $sth->STORE('gbase_stat'=>$gbstat);
         $sth->STORE('foreign_params'=>0); # pure select
         $sth->STORE('NAME' => \@names);
         $sth->STORE('TYPE' => \@types);
         $sth->STORE('NULLABLE' => [ (0) x @names ]);
         $sth->STORE('NUM_OF_FIELDS' => scalar(@names));
         $sth->STORE('NUM_OF_PARAMS' => $num_of_params);
	 return $sth;
        } # like select

        elsif ($statement=~/^\s*delete/si) {
         my $parsed_ok=($tablename,$whereclause)=
            ($statement=~/^\s*delete\s+from\s+(\S+)(.*)$/si);
         if (!$parsed_ok) { 
            return $sth->DBI::set_err(1,"syntax error in query");
         } 
         $statement="select from $tablename $whereclause";
         my $num_of_params;
	 ($num_of_params,$statement)=DBD::Gigabase::param_process($statement);
	 my $gbstat=new Gigabase::Statement($con,$statement) 
             || return $dbh->DBI::set_err($con->errcode,$con->errstr);

         $sth->STORE('dbi_params'=>[]);
         $sth->STORE('gbase_class'=>'delete'); 
         $sth->STORE('gbase_stat'=>$gbstat);
         $sth->STORE('NUM_OF_PARAMS' => $num_of_params);
        }

	elsif ($statement=~/^\s*insert/si) {
         my ($col_expr,$val_expr);
	 # insert into table (field1,field2) values (val1,val2);
         my $parsed_ok=($tablename,$col_expr,$val_expr)=
      ($statement=~/^\s*insert\s+into\s+(\w+?)\s*\((.+)\)\s*values\s*\((.+)\)/si);
         if (!$parsed_ok) { 
	  # insert into table (val1,val2,val3);
            $parsed_ok=($tablename,$val_expr)=
         ($statement=~/^\s*insert\s+into\s+(\S+)\s*values\s*\((.+)\)/si);
	    if ($parsed_ok) { $col_expr='';}
	    else {
              return $sth->DBI::set_err(1,"syntax error in query");
	    }
         } ##
         my ($names_ref,$types_ref);
         (($names_ref,$types_ref)=$con->describe_table_2arrays($tablename));
         return $dbh->DBI::set_err(1,"no such table $tablename") unless $names_ref;
	 my @ins_col_names;
	 my %ins_vals;
	 my @ins_params;
         if ($col_expr eq '') { @ins_col_names=@$names_ref;}
	 else { 
           my @cols=split (/,/s,$col_expr);
	   map {
           my $colname=$_;
            if ((!($colname=~/^\w+$/))or (! grep{$colname eq $_}@$names_ref)) {
             return $dbh->DBI::set_err(1,"specified column $colname does not exists");
            } else {
              push @ins_col_names,$colname;
            }
	   } @cols;
	 }
	 # @ins_col_names filled
         my @vals;
         eval {
           @vals=DBD::Gigabase::parse_values($val_expr,0);
         };
         if ($@) { return $dbh->DBI::set_err(1,
            "text of SQL operator is not correct");
         }
	 my $i=0;
         if (scalar @vals ne scalar @ins_col_names) {
          return $dbh->DBI::set_err(1,
           "number of fields not equal to number of values");
         }
         map { 
           my $colname=$ins_col_names[$i];
           my $val=$_;
           if ($val eq '?') {
	    push @ins_params,$colname;
           }
	   $ins_vals{$colname}=$val;
           #print "$i : $val [ $colname ] \n";
	   $i++;
         } @vals;

         $statement="insert into $tablename";
	 my $gbstat=new Gigabase::Statement($con,$statement) 
             || return $dbh->DBI::set_err($con->errcode,$con->errstr);
         foreach my $name (@ins_col_names) {
          $gbstat->bind_column($name,\$ins_vals{$name});
         }
         $sth->STORE('ins_params'=>\@ins_params);
         $sth->STORE('foreign_params'=>scalar @ins_params);
         $sth->STORE('ins_vals'=>\%ins_vals);
         $sth->STORE('ins_colnames'=>\@ins_col_names);
         $sth->STORE('dbi_params'=>[]);
         $sth->STORE('gbase_class'=>'insert'); 
         $sth->STORE('gbase_stat'=>$gbstat);
         $sth->STORE('NUM_OF_PARAMS' => scalar @ins_params);
	}

	elsif ($statement=~/^\s*update/si) {
	 my $set_expr;
         my $parsed_ok=($tablename,$set_expr)=
            ($statement=~/^\s*update\s+(.*?)\s+set\s+(.+)$/si);
         if (!$parsed_ok) { 
              return $sth->DBI::set_err(1,"syntax error in query");
         } ##
         my ($names_ref,$types_ref);
         (($names_ref,$types_ref)=$con->describe_table_2arrays($tablename));
         return $dbh->DBI::set_err(1,"no such table $tablename") unless $names_ref;
         my ($pos,@eqs);
         eval {
          ($pos,@eqs)=DBD::Gigabase::parse_sqlset($set_expr,0);
         };
         if ($@) { return $sth->DBI::set_err(1,
            "text of SQL operator is not correct");
         }
         $whereclause=substr($set_expr,$pos);
	 if (scalar @eqs > scalar @$names_ref) {
            return $sth->DBI::set_err(1,"too much specified columns in update");
	 }

	 my %new_vals;        # all columns wich are updated
         my @new_params;# names of columns which updated via =?
         map {
          my ($ename,$eval)=@{$_};
           if (! grep {$ename eq $_} @$names_ref ) {
            return $dbh->DBI::set_err(1,"specified column $ename does not exists");
           }	
	   if ($eval eq '?') {
	     push @new_params,$ename;
	   }
	   $new_vals{$ename}=$eval;
         } @eqs;
         # now,when execute ,evaluate @new_param_names,bind all %new_columns,
	 #  and do update for each row

         $statement="select from $tablename where $whereclause";
         my $num_of_params;
	 ($num_of_params,$statement)=DBD::Gigabase::param_process($statement);
	 my $gbstat=new Gigabase::Statement($con,$statement) 
             || return $dbh->DBI::set_err($con->errcode,$con->errstr);
	 my $total_params=$num_of_params+scalar @new_params;
         $sth->STORE('new_params'=>\@new_params);
         $sth->STORE('foreign_params'=>scalar @new_params);
         $sth->STORE('new_vals'=>\%new_vals);
         $sth->STORE('dbi_params'=>[]);
         $sth->STORE('gbase_class'=>'update'); 
         $sth->STORE('gbase_stat'=>$gbstat);
         $sth->STORE('NUM_OF_PARAMS' => $total_params);

	}# end of update
	else {
            return $dbh->DBI::set_err(1,"text of SQL operator is not correct");
	}
    }
    $sth;
}

sub disconnect ($) {
    my $dbh=shift;
    my $con=$dbh->FETCH('gbase_con');
    DBD::Gigabase::db::driver_commit($dbh) if ($dbh->FETCH('AutoCommit'));
    $con->close;
    $dbh->STORE(Active => 0);
    1;
}

sub FETCH ($$) {
    my ($dbh, $attrib) = @_;
    if ($attrib eq 'AutoCommit') {
        return $dbh->{'AutoCommit'};
    } elsif ($attrib eq (lc $attrib)) {
        # Driver private attributes are lower cased
        return $dbh->{$attrib};
    }
    # else pass up to DBI to handle
    return $dbh->SUPER::FETCH($attrib);
}

sub STORE ($$$) {
    my ($dbh, $attrib, $value) = @_;
    if ($attrib eq 'AutoCommit') {
        $dbh->{'AutoCommit'}=$value;
        return 1;
    } elsif ($attrib eq (lc $attrib)) {
        # Driver private attributes are lower cased
        $dbh->{$attrib} = $value;
        return 1;
    }
    return $dbh->SUPER::STORE($attrib, $value);

}

sub DESTROY ($) {
    my $dbh=shift;
    if ($dbh->FETCH('ActiveKids')) {
      warn "some statements not closed";
    }
    $dbh->disconnect if $dbh->FETCH('Active');
    undef;
}

sub commit ($) {
    my($dbh) = shift;
    if ($dbh->FETCH('Warn') && $dbh->FETCH('AutoCommit')) {
	warn("Commit ineffective while AutoCommit is on", -1);
    }
    return DBD::Gigabase::db::driver_commit($dbh);
}

sub driver_commit { #for internal use
    my($dbh) = shift;
    my $con=$dbh->FETCH('gbase_con');
    if (!$con->commit()) {
     return $dbh->DBI::set_err($con->errcode,$con->errstr);
    }
    1;
}
 
sub rollback ($) {
    my($dbh) = shift;
    if ($dbh->FETCH('Warn') && $dbh->FETCH('AutoCommit')) {
	warn("Rollback ineffective while AutoCommit is on", -1);
        return 0;
    }
    my $con=$dbh->FETCH('gbase_con');
    if (!$con->rollback()) {
     return $dbh->DBI::set_err($con->errcode,$con->errstr);
    }
    1;
}

sub ping {
   my $dbh = shift;
   my $sth = $dbh->prepare_cached("select name from Metatable where name = ''")
    or return 0;
   $sth->execute or return 0;
   $sth->finish;
   return 1;
}

# driver specific functions:
# usage $dbh->func('precommit');
sub precommit{
 my $dbh=shift;
 my $con=$dbh->FETCH('gbase_con');
 $con->precommit;
}

} # package  database

{
 package DBD::Gigabase::st;  # STATEMENT
 $imp_data_size=0;
 use Gigabase qw/:clicodes/;
 use strict;
 my @allowed_attr=('NAME','TYPE','NULLABLE','PRECISION','SCALE','NUM_OF_FIELD');
 my %allowed_attr=map { $_,1;} @allowed_attr;

 sub FETCH { 
  my ($sth,$attrib)=@_;
  if (($allowed_attr{$attrib}) or ($attrib eq (lc $attrib))) {
    return $sth->{$attrib};
    }
  return $sth->SUPER::FETCH($attrib); 
 }

 sub STORE { 
  my ($sth,$attrib,$value)=@_;
  if (($allowed_attr{$attrib}) or ($attrib eq (lc $attrib))) {
    return $sth->{$attrib}=$value;
  }
  return $sth->SUPER::STORE($attrib,$value);
 }

 sub bind_param() {
  my ($sth,$pnum,$val,$attr)=@_;
  my $type = (ref $attr) ? $attr->{TYPE} : $attr;
  if ($type) {
   my $dbh = $sth->{Database};
   $val = $dbh->quote($sth, $type);
  }
  my $dbi_params = $sth->FETCH('dbi_params');
  $dbi_params->[$pnum-1] = $val;
  1;
 }

 sub execute {
  my($sth, @bind_values) = @_;
  my $params;
  if (@bind_values) {
   @bind_values=map { \$_;} @bind_values;
   $params=\@bind_values;
  }else {
   $params= $sth->FETCH('dbi_params');
  } 
  my $numParam = $sth->FETCH('NUM_OF_PARAMS');
  my $dbh=$sth->{Database};
  if (@$params != $numParam) { 
        $sth->DBI::set_err(1,"execute() with " . @$params .
                            " param(s) called, but $numParam needed");
  }
  my $class=$sth->FETCH('gbase_class');
  my $gbase_stat=$sth->FETCH('gbase_stat');
  my $foreign_params=$sth->FETCH('foreign_params') || 0;# update set,insert
  if ($class ne 'insert') { # all,but insert
   for (my $i=$foreign_params;$i<$numParam;$i++) {
    my $pnum=$i-$foreign_params;
    $gbase_stat->bind_parameter("p$pnum",$params->[$i]) 
     || return $sth->DBI::set_err(
       1,"problem with parameters:" . $gbase_stat->errstr);
   }
  }
  my $rows;
  my $autocommit=$dbh->FETCH('AutoCommit');
  if ($class eq 'select') {
    $rows=$gbase_stat->fetch(0) 
     || return $sth->DBI::set_err($gbase_stat->errcode,$gbase_stat->errstr);
  } 

  elsif ($class eq 'delete') {
    $rows=$gbase_stat->fetch(1)
     || return $sth->DBI::set_err(
       1,"fetch for delete failed:" . $gbase_stat->errstr);
    if ($rows>0) { 
       my $rc=$gbase_stat->remove ;
       if (!$rc) { 
        return $sth->DBI::set_err(1,"remove() failed:" . $gbase_stat->errstr);
       }
    }
    if ($autocommit) {DBD::Gigabase::db::driver_commit($dbh);}
  } 

  elsif ($class eq 'update') {
     my $new_params=$sth->FETCH('new_params'); # is @
     my $new_vals=$sth->FETCH('new_vals'); # is % , all values bind_comluned
     # eval values of foreign params 
     for (my $i=0;$i<$foreign_params;$i++) {
      $new_vals->{$new_params->[$i]}=${$params->[$i]};  
     }
     # bind all colunms
     # cycle {
     #  get next
     #  update values from $new_vals
     #  send update to server
     # }
     my %tmp_rec=%$new_vals;
     foreach my $n (keys %$new_vals) {
      $gbase_stat->bind_column($n,\$tmp_rec{$n});
     }
     $rows=$gbase_stat->fetch(1);
     if ($rows>=1) {
      return $sth->DBI::set_err(1,"fetch() for update failed:" .
         $gbase_stat->errstr) unless defined $rows;
      while($gbase_stat->get_next()) {
       foreach my $n (keys %$new_vals) {
        $tmp_rec{$n}=$new_vals->{$n};
       }
       $gbase_stat->update || 
       return $sth->DBI::set_err(1,"update() failed:" . $gbase_stat->errstr);
      }
    }
    if ($autocommit) {DBD::Gigabase::db::driver_commit($dbh);}
  }

  elsif ($class eq 'insert') {
   my $ins_colnames=$sth->FETCH('ins_colnames'); # @
   my $ins_params=$sth->FETCH('ins_params'); # @ 
   my $ins_vals=$sth->FETCH('ins_vals'); # %, already binded
   for (my $i=0;$i<$numParam;$i++){
    $ins_vals->{$ins_params->[$i]}=${$params->[$i]};
   }
   my $oid=$gbase_stat->insert || 
       return $sth->DBI::set_err(1,"insert() failed:" . $gbase_stat->errstr);
   $rows=0;
   $sth->STORE('gbase_oid',$oid);
   if ($autocommit) {DBD::Gigabase::db::driver_commit($dbh);}
  }
  $sth->STORE('gbase_rows',$rows);
  $rows || '0E0';
}

 sub fetchrow_arrayref {
  my ($sth)=@_;
  if ($sth->FETCH('gbase_class') ne 'select') {
   $sth->DBI::set_err(1,'unable to fetch data from not a select statement');
  }
  my @data=();
  my $bind_hash_ref=$sth->FETCH('hash_of_bind');
  my $names=$sth->FETCH('NAME');
  my $dbh=$sth->{'Database'};
  my $gbase_stat=$sth->FETCH('gbase_stat');
  if (!$gbase_stat->get_next()) { 
     if ($gbase_stat->errcode == cli_not_found) 
        { 
         #AutoCommit here
         if ($dbh->FETCH('AutoCommit') and 
             $sth->FETCH('gbase_class') eq 'select') {
           my $database=$sth->{Database};
           DBD::Gigabase::db::driver_commit($database);
         }
         return undef;# no more tuples
         }
     if ($gbase_stat->errcode ==cli_not_fetched ) { 
      return $sth->DBI::set_err(1,'fetching from not executed statement');
     } else {
       return $sth->DBI::set_err($gbase_stat->errcode,$gbase_stat->errstr);
     }
  }
  foreach my $n (@$names) {
   push @data,$$bind_hash_ref{$n};
  }
  $sth->STORE('gbase_oid',$gbase_stat->get_oid);
  return $sth->_set_fbav(\@data); 
 }

 *fetch=\&fetchrow_arrayref;

 sub rows { 
     my $sth=shift; 
     return $sth->FETCH('gbase_rows');
 }

 sub finish { 
 # no more data fetches before next execute() or DESTROY
  my $self=shift;
  if ($self->FETCH('Active')) {
   $self->STORE('Active',0);
  }
  1;
 }

 sub DESTROY { 
  my $self=shift;
  my $class=$self->FETCH('gbase_class');
  if ($self->FETCH('Active') and $class eq 'select') {
  # warn "not finished statement.";
   $self->finish;
  }
  1;
 }

}# end of st

1;

__END__


=head1 NAME

DBD::Gigabase - DBI driver for GigaBASE RDBMS server

=head1 SYNOPSIS

  use DBI;

  $dbh = DBI->connect("dbi:Gigabase:host=localhost;port=6100",
                      "guest", "guest");

  # See the DBI module documentation for full details

=head1 DESCRIPTION

DBD::Gigabase is a Perl module which works with the DBI module to provide
access to GigaBASE databases runned with cli servers.
Implemented as SQL emulation around Gigabase perl module wich required.

=head1 VERSION

 $Revision: 1.1 $
 $Date: 2008/04/04 11:02:30 $

=head1 MODULE DOCUMENTATION

This documentation describes driver specific behavior and restrictions. 
It is not supposed to be used as the only reference for the user. In any 
case consult the DBI documentation first !

=head1 THE DBI CLASS

=head2 DBI Class Methods

=over 4

=item B<connect>

To connect to a database with a minimum of parameters, use the 
following syntax: 

  $dbh = DBI->connect("dbi:Gigabase:host=localhost;port=6100","guest","guest");

This connects to the database $dbname at localhost:6100 as 'guest' user with the
'guest' password by default if host and port are not specified.

=item B<available_drivers>

  @driver_names = DBI->available_drivers;

Implemented by DBI, no driver-specific impact.

=item B<data_sources>

This method is not implemented.There are no correct way to find 
GigaBASE servers.

=item B<trace>

  DBI->trace($trace_level, $trace_file)

Implemented by DBI, no driver-specific impact.

=back


=head2 DBI Dynamic Attributes

See Common Methods. 

=head1 METHODS COMMON TO ALL HANDLES

=over 4

=item B<err>

  $rv = $h->err;

Supported by the driver as proposed by DBI. 

=item B<errstr>

  $str = $h->errstr;

Supported by the driver as proposed by DBI. 

=item B<state>

This method is not yet implemented.

=item B<trace>

  $h->trace($trace_level, $trace_filename);

Implemented by DBI, no driver-specific impact.

=item B<trace_msg>

  $h->trace_msg($message_text);

Implemented by DBI, no driver-specific impact.

=item B<func>

GigaBASE specific functions available via this method.
Only B<precommit> supported for now.
Usage:
  $dbh->func('precommit');

=back

=head1 ATTRIBUTES COMMON TO ALL HANDLES

=over 4

=item B<Warn> (boolean, inherited)

Implemented by DBI, no driver-specific impact.

=item B<Active> (boolean, read-only)

Supported by the driver as proposed by DBI. A database 
handle is active while it is connected and  statement 
handle is active until it is finished. 

=item B<Kids> (integer, read-only)

Implemented by DBI, no driver-specific impact.

=item B<ActiveKids> (integer, read-only)

Implemented by DBI, no driver-specific impact.

=item B<CachedKids> (hash ref)

Implemented by DBI, no driver-specific impact.

=item B<CompatMode> (boolean, inherited)

Not used by this driver. 

=item B<InactiveDestroy> (boolean)

Implemented by DBI, no driver-specific impact.

=item B<PrintError> (boolean, inherited)

Implemented by DBI, no driver-specific impact.

=item B<RaiseError> (boolean, inherited)

Implemented by DBI, no driver-specific impact.

=item B<ChopBlanks> (boolean, inherited)

Not supported yet.

=item B<LongReadLen> (integer, inherited)

Not supported yet.

=item B<LongTruncOk> (boolean, inherited)

Not supported yet.

=item B<Taint> (boolean, inherited)

Implemented by DBI, no driver-specific impact.

=back

=head1 DATABASE HANDLE OBJECTS

=head2 Database Handle Methods

=over 4

=item B<selectrow_array>

  @row_ary = $dbh->selectrow_array($statement, \%attr, @bind_values);

Implemented by DBI, no driver-specific impact.

=item B<selectall_arrayref>

  $ary_ref = $dbh->selectall_arrayref($statement, \%attr, @bind_values);

Implemented by DBI, no driver-specific impact.

=item B<selectcol_arrayref>

  $ary_ref = $dbh->selectcol_arrayref($statement, \%attr, @bind_values);

Implemented by DBI, no driver-specific impact.

=item B<prepare>

  $sth = $dbh->prepare($statement, \%attr);

Supported by the driver as proposed by DBI.
When AutoCommit is On, this method implicitly starts a new transaction,
which will be automatically committed after the following execute() or the
last fetch(), depending on the statement type. For select statements,
commit automatically takes place after the last fetch(), or by explicitly 
calling finish() method if there are any rows remaining. For non-select
statements, execute() will implicitly commits the transaction. 

=item B<prepare_cached>

  $sth = $dbh->prepare_cached($statement, \%attr);

Implemented by DBI, no driver-specific impact. 

=item B<do>

  $rv  = $dbh->do($statement, \%attr, @bind_values);

Supported by the driver as proposed by DBI.
This should be used for non-select statements, where the driver doesn't take
the conservative prepare - execute steps, thereby speeding up the execution
time. But if this method is used with bind values, the speed advantage
diminishes as this method calls prepare() for binding the placeholders.
Instead of calling this method repeatedly with bind values, it would be
better to call prepare() once, and execute() many times.

See the notes for the execute method elsewhere in this document. 

=item B<commit>

  $rc  = $dbh->commit;

Supported by the driver as proposed by DBI. 

=item B<rollback>

  $rc  = $dbh->rollback;

Supported by the driver as proposed by DBI. 

=item B<disconnect>

  $rc  = $dbh->disconnect;

Supported by the driver as proposed by DBI. 

=item B<ping>

  $rc = $dbh->ping;

This driver supports the ping-method, which can be used to check the 
validity of a database-handle. This is especially required by
C<Apache::DBI>.

=item B<table_info>

  $sth = $dbh->table_info;

Not implemented.
All types are converted to SQL standarts types.

=item B<tables>

  @names = $dbh->tables;

Not implemented yet.

=item B<type_info_all>

  $type_info_all = $dbh->type_info_all;

Not implemented.
All types are converted to SQL standart types.

=item B<type_info>

  @type_info = $dbh->type_info($data_type);

Not imlpemented.

=item B<quote>

  $sql = $dbh->quote($value, $data_type);

Implemented by DBI, no driver-specific impact. 

=back

=head2 Database Handle Attributes

=over 4

=item B<AutoCommit>  (boolean)

Supported by the driver as proposed by DBI. 

=item B<Driver>  (handle)

Implemented by DBI, no driver-specific impact. 

=item B<Name>  (string, read-only)

Not yet implemented.

=item B<RowCacheSize>  (integer)

Implemented by DBI, not used by the driver.

=back

=head1 STATEMENT HANDLE OBJECTS


=head2 Statement Handle Methods

=over 4

=item B<bind_param>

Supported by the driver as proposed by DBI. 
The SQL data type passed as the third argument is ignored. 

=item B<bind_param_inout>

Not supported by this driver. 

=item B<execute>

  $rv = $sth->execute(@bind_values);

Supported by the driver as proposed by DBI. 
Number of affected rows returned.

=item B<fetchrow_arrayref>

  $ary_ref = $sth->fetchrow_arrayref;

Supported by the driver as proposed by DBI. 

=item B<fetchrow_array>

  @ary = $sth->fetchrow_array;

Supported by the driver as proposed by DBI. 

=item B<fetchrow_hashref>

  $hash_ref = $sth->fetchrow_hashref;

Supported by the driver as proposed by DBI. 

=item B<fetchall_arrayref>

  $tbl_ary_ref = $sth->fetchall_arrayref;

Implemented by DBI, no driver-specific impact. 

=item B<finish>

  $rc = $sth->finish;

Supported by the driver as proposed by DBI. 

=item B<rows>

  $rv = $sth->rows;

Supported by the driver as proposed by DBI. 

=item B<bind_col>

  $rc = $sth->bind_col($column_number, \$var_to_bind, \%attr);

Supported by the driver as proposed by DBI. 

=item B<bind_columns>

  $rc = $sth->bind_columns(\%attr, @list_of_refs_to_vars_to_bind);

Implemented by DBI, no driver-specific impact. 

=item B<dump_results>

  $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh);

Implemented by DBI, no driver-specific impact. 

=back

=head2 Statement Handle Attributes

=over 4

Gigabase-specific attributes name starts with gbase_ .

=item B<NUM_OF_FIELDS>  (integer, read-only)

Supported by the driver as proposed by DBI. 

=item B<NUM_OF_PARAMS>  (integer, read-only)

Supported by the driver as proposed by DBI. 

=item B<NAME>  (array-ref, read-only)

Supported by the driver as proposed by DBI. 

=item B<NAME_lc>  (array-ref, read-only)

Implemented by DBI, no driver-specific impact. 

=item B<NAME_uc>  (array-ref, read-only)

Implemented by DBI, no driver-specific impact. 

=item B<TYPE>  (array-ref, read-only)

Supported by the driver as returning SQL standard 
data types.

=item B<PRECISION>  (array-ref, read-only)

Not implemented.

=item B<SCALE>  (array-ref, read-only)

Not implemented.

=item B<NULLABLE>  (array-ref, read-only)

Supported by the driver as proposed by DBI. 
There are no null values in GigaBASE.

=item B<CursorName>  (string, read-only)

Not implemented.

=item B<Statement>  (string, read-only)

Supported by the driver as proposed by DBI. 

=item B<RowCache>  (integer, read-only)

Not supported by the driver. 

=item B<gbase_oid> (integer, read-only)

Specific attribure.Can be available for B<insert> and B<select> statements
and returns Object IDentificator of inserted record.

=item B<gbase_rowid> (integer, read-only)

Specific attribure.Can be available for B<insert> statements.
See autoincrement feature in GigaBASE documentation.


=back

=head1 AUTHOR

=item * DBI by Tim Bunce <Tim.Bunce@ig.co.uk>

=item * DBD::Gigabase by Pavel Zheltouhov <pavlo@tvrn.ru>

Partially based on the DBD::ExampleP.

=head1 SQL NOTES

 DBI emulation layer provides extension wich unavailable in SubSQL,
 a native SQL subset of Gigabase RDBMS.
 Native specific as 'follow by' and expressions supported.
 Expression in selects( such select tab.a+tab.b from tab) 
 and update (as update tab set tab.a=tab.a+1) not available.
 Only scalar values must be specified.

=item * selecting some columns 

  select field1,field2 from table1

=item * inserting by column names

 insert into tab (field1,field2) values (value1,value2);
 
  
=head1 ACKNOWLENGEMENTS 
 
Ratmir ADS www.ratmir.ru as sponsors of development.

=head1 BUGS

You need GigaBASE version higher than 2.41 to use new style inserts
with rowid attribute.

=head1 SEE ALSO

DBI(3),Gigabase(3).
guide about GigaBASE - Object-Relational database system 
at http://www.ispras.ru/~knizhnik/gigabase.html

=head1 COPYRIGHT

The DBD::Gigabase module is a free software. 
You may distribute under the terms of either the GNU Artistic License,
as specified in the Perl README file.

=cut

